NHL_Shot_Analysis_Visualization

NHL Shot Analysis Visualization

Load library

library(ggpubr)

## Warning: package 'ggpubr' was built under R version 4.2.3

## Loading required package: ggplot2

## Warning: package 'ggplot2' was built under R version 4.2.3

library(tidyverse)

## Warning: package 'tidyverse' was built under R version 4.2.3

## Warning: package 'tibble' was built under R version 4.2.3

## Warning: package 'tidyr' was built under R version 4.2.3

## Warning: package 'purrr' was built under R version 4.2.3

## Warning: package 'stringr' was built under R version 4.2.3

## Warning: package 'forcats' was built under R version 4.2.3

## Warning: package 'lubridate' was built under R version 4.2.3

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.0     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ lubridate 1.9.2     ✔ tibble    3.2.1
## ✔ purrr     1.0.1     ✔ tidyr     1.3.0

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors

library(forcats)
library(jpeg)
library(grid)
library(gganimate)

## Warning: package 'gganimate' was built under R version 4.2.3

library(visdat)

## Warning: package 'visdat' was built under R version 4.2.3

library(eeptools)

## Warning: package 'eeptools' was built under R version 4.2.3

library(glmnet) # Load glmnet

## Warning: package 'glmnet' was built under R version 4.2.3

## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## 
## The following objects are masked from 'package:tidyr':
## 
##     expand, pack, unpack
## 
## Loaded glmnet 4.1-8

library(plotmo) # for plot_glmnet

## Warning: package 'plotmo' was built under R version 4.2.3

## Loading required package: Formula
## Loading required package: plotrix
## Loading required package: TeachingDemos

## Warning: package 'TeachingDemos' was built under R version 4.2.3

library(rpart)                      # Popular decision tree algorithm

## Warning: package 'rpart' was built under R version 4.2.3

library(rattle)                 # Fancy tree plot

## Warning: package 'rattle' was built under R version 4.2.3

## Loading required package: bitops
## 
## Attaching package: 'bitops'
## 
## The following object is masked from 'package:Matrix':
## 
##     %&%
## 
## Rattle: A free graphical interface for data science with R.
## Version 5.5.1 Copyright (c) 2006-2021 Togaware Pty Ltd.
## Type 'rattle()' to shake, rattle, and roll your data.

library(rpart.plot)             # Enhanced tree plots

## Warning: package 'rpart.plot' was built under R version 4.2.3

library(RColorBrewer)               # Color selection for fancy tree plot
library(party)                  # Alternative decision tree algorithm

## Warning: package 'party' was built under R version 4.2.3

## Loading required package: mvtnorm

## Warning: package 'mvtnorm' was built under R version 4.2.3

## Loading required package: modeltools
## Loading required package: stats4
## Loading required package: strucchange

## Warning: package 'strucchange' was built under R version 4.2.3

## Loading required package: zoo
## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## Loading required package: sandwich
## 
## Attaching package: 'strucchange'
## 
## The following object is masked from 'package:stringr':
## 
##     boundary
## 
## 
## Attaching package: 'party'
## 
## The following object is masked from 'package:dplyr':
## 
##     where

library(partykit)               # Convert rpart object to BinaryTree

## Warning: package 'partykit' was built under R version 4.2.3

## Loading required package: libcoin

## Warning: package 'libcoin' was built under R version 4.2.3

## 
## Attaching package: 'partykit'
## 
## The following objects are masked from 'package:party':
## 
##     cforest, ctree, ctree_control, edge_simple, mob, mob_control,
##     node_barplot, node_bivplot, node_boxplot, node_inner, node_surv,
##     node_terminal, varimp

library(caret)  

## Warning: package 'caret' was built under R version 4.2.3

## Loading required package: lattice
## 
## Attaching package: 'caret'
## 
## The following object is masked from 'package:purrr':
## 
##     lift

library(randomForest)

## Warning: package 'randomForest' was built under R version 4.2.3

## randomForest 4.7-1.1
## Type rfNews() to see new features/changes/bug fixes.
## 
## Attaching package: 'randomForest'
## 
## The following object is masked from 'package:rattle':
## 
##     importance
## 
## The following object is masked from 'package:dplyr':
## 
##     combine
## 
## The following object is masked from 'package:ggplot2':
## 
##     margin

library(sparcl) # Sparse Clustering
library(cluster) # Load cluster

## Warning: package 'cluster' was built under R version 4.2.3

library(factoextra) # clustering algorithms & visualization

## Warning: package 'factoextra' was built under R version 4.2.3

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

library(xgboost)

## Warning: package 'xgboost' was built under R version 4.2.3

## 
## Attaching package: 'xgboost'
## 
## The following object is masked from 'package:rattle':
## 
##     xgboost
## 
## The following object is masked from 'package:dplyr':
## 
##     slice

library(xgboostExplainer) # Load XGboost Explainer
library(pROC) # Load proc

## Warning: package 'pROC' was built under R version 4.2.3

## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## 
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

Original Data & Cleaning

Data Cleaning has been done in the Daniel Analysis.Rmd. Referring to Daniel Analysis.Rmd for details of cleaning.

Load Clean Data

NHL_Shot_Analysis_Data <- read_csv("NHL_Shot_Analysis_Data.csv", col_select = -1)

## New names:
## Rows: 934188 Columns: 21
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (9): play_id, event, secondaryType, periodType, skatersType, skater_fu... dbl
## (11): game_id, team_id_for, team_id_against, x, y, period, periodTime, ... dttm
## (1): dateTime
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

Data preview

# How many rows and columns?
dim(NHL_Shot_Analysis_Data)

## [1] 934188     21

# What are the data types and what do they look like in general
summary(NHL_Shot_Analysis_Data)

##    play_id             game_id           team_id_for    team_id_against
##  Length:934188      Min.   :2.005e+09   Min.   : 1.00   Min.   : 1.00  
##  Class :character   1st Qu.:2.013e+09   1st Qu.: 8.00   1st Qu.: 8.00  
##  Mode  :character   Median :2.016e+09   Median :16.00   Median :16.00  
##                     Mean   :2.015e+09   Mean   :17.85   Mean   :17.82  
##                     3rd Qu.:2.018e+09   3rd Qu.:24.00   3rd Qu.:24.00  
##                     Max.   :2.019e+09   Max.   :90.00   Max.   :90.00  
##                                                                        
##     event           secondaryType            x                 y         
##  Length:934188      Length:934188      Min.   :-99.000   Min.   :-42.00  
##  Class :character   Class :character   1st Qu.:-64.000   1st Qu.:-14.00  
##  Mode  :character   Mode  :character   Median : -2.000   Median :  0.00  
##                                        Mean   :  0.007   Mean   : -0.28  
##                                        3rd Qu.: 64.000   3rd Qu.: 13.00  
##                                        Max.   : 99.000   Max.   : 42.00  
##                                        NA's   :4769      NA's   :4764    
##      period       periodType          periodTime     periodTimeRemaining
##  Min.   :1.000   Length:934188      Min.   :   0.0   Min.   :   0.0     
##  1st Qu.:1.000   Class :character   1st Qu.: 276.0   1st Qu.: 286.0     
##  Median :2.000   Mode  :character   Median : 577.0   Median : 590.0     
##  Mean   :2.074                      Mean   : 585.7   Mean   : 588.7     
##  3rd Qu.:3.000                      3rd Qu.: 890.0   3rd Qu.: 892.0     
##  Max.   :8.000                      Max.   :1200.0   Max.   :1200.0     
##                                                      NA's   :4714       
##     dateTime                        skaters_id      skatersType       
##  Min.   :2005-10-06 01:00:00.00   Min.   :8445386   Length:934188     
##  1st Qu.:2013-12-03 01:36:50.75   1st Qu.:8471214   Class :character  
##  Median :2016-12-05 04:45:19.00   Median :8474578   Mode  :character  
##  Mean   :2016-04-27 14:02:19.52   Mean   :8473715                     
##  3rd Qu.:2019-01-18 01:32:25.50   3rd Qu.:8476469                     
##  Max.   :2020-09-29 03:49:05.00   Max.   :8481813                     
##                                                                       
##  skater_full_name   skaters_position   skaters_nationality  skaters_age   
##  Length:934188      Length:934188      Length:934188       Min.   :18.10  
##  Class :character   Class :character   Class :character    1st Qu.:24.10  
##  Mode  :character   Mode  :character   Mode  :character    Median :26.80  
##                                                            Mean   :27.31  
##                                                            3rd Qu.:30.10  
##                                                            Max.   :45.90  
##                                                                           
##  shootsCatches      goalie_saving_rate
##  Length:934188      Min.   :0.500     
##  Class :character   1st Qu.:0.910     
##  Mode  :character   Median :0.913     
##                     Mean   :0.913     
##                     3rd Qu.:0.916     
##                     Max.   :1.000     
##                     NA's   :3878

# The names of all columns of the data
names(NHL_Shot_Analysis_Data)

##  [1] "play_id"             "game_id"             "team_id_for"        
##  [4] "team_id_against"     "event"               "secondaryType"      
##  [7] "x"                   "y"                   "period"             
## [10] "periodType"          "periodTime"          "periodTimeRemaining"
## [13] "dateTime"            "skaters_id"          "skatersType"        
## [16] "skater_full_name"    "skaters_position"    "skaters_nationality"
## [19] "skaters_age"         "shootsCatches"       "goalie_saving_rate"

# First 6 rows of the data
head(NHL_Shot_Analysis_Data)

## # A tibble: 6 × 21
##   play_id    game_id team_id_for team_id_against event secondaryType     x     y
##   <chr>        <dbl>       <dbl>           <dbl> <chr> <chr>         <dbl> <dbl>
## 1 201602004…  2.02e9          16               4 Shot  Wrist Shot      -71     9
## 2 201602004…  2.02e9          16               4 Goal  Wrap-around     -88     5
## 3 201602004…  2.02e9           4              16 Shot  Wrist Shot       56    -7
## 4 201602004…  2.02e9          16               4 Shot  Slap Shot       -37   -24
## 5 201602004…  2.02e9           4              16 Shot  Wrist Shot       57   -20
## 6 201602004…  2.02e9           4              16 Shot  Slap Shot        34    14
## # ℹ 13 more variables: period <dbl>, periodType <chr>, periodTime <dbl>,
## #   periodTimeRemaining <dbl>, dateTime <dttm>, skaters_id <dbl>,
## #   skatersType <chr>, skater_full_name <chr>, skaters_position <chr>,
## #   skaters_nationality <chr>, skaters_age <dbl>, shootsCatches <chr>,
## #   goalie_saving_rate <dbl>

# Last 6 rows of the data
tail(NHL_Shot_Analysis_Data)

## # A tibble: 6 × 21
##   play_id    game_id team_id_for team_id_against event secondaryType     x     y
##   <chr>        <dbl>       <dbl>           <dbl> <chr> <chr>         <dbl> <dbl>
## 1 201803041…  2.02e9          19               6 Shot  Wrist Shot      -46    19
## 2 201803041…  2.02e9          19               6 Goal  Snap Shot       -77     7
## 3 201803041…  2.02e9          19               6 Shot  Snap Shot       -69     7
## 4 201803041…  2.02e9          19               6 Shot  Snap Shot       -65    -4
## 5 201803041…  2.02e9           6              19 Shot  Wrist Shot       42     3
## 6 201803041…  2.02e9           6              19 Goal  Wrist Shot       44    24
## # ℹ 13 more variables: period <dbl>, periodType <chr>, periodTime <dbl>,
## #   periodTimeRemaining <dbl>, dateTime <dttm>, skaters_id <dbl>,
## #   skatersType <chr>, skater_full_name <chr>, skaters_position <chr>,
## #   skaters_nationality <chr>, skaters_age <dbl>, shootsCatches <chr>,
## #   goalie_saving_rate <dbl>

# How many NAs are there?
sum(is.na(NHL_Shot_Analysis_Data))

## [1] 18135

NAs handling

# Check the NAs in data set
sum(is.na(NHL_Shot_Analysis_Data))

## [1] 18135

# Remove all NAs in the data set
NHL_Shot_Analysis_Data <- na.omit(NHL_Shot_Analysis_Data)

Data Visualization

Focus on the secondaryType of “shot” & “goal” in the event column. Calculate the frequency of each types of shots and their conversion rate.

# Examine different types of shots
summary(as.factor(NHL_Shot_Analysis_Data$secondaryType))

##    Backhand   Deflected   Slap Shot   Snap Shot      Tip-In Wrap-around 
##       76500       14778      163164      132051       44655       10359 
##  Wrist Shot 
##      484024

# Create a table to summarize the frequency of different types of shots
shots.count.df <- NHL_Shot_Analysis_Data  %>%
  group_by(secondaryType) %>%
  summarise(count = n()) %>%
  arrange(desc(count))

print(shots.count.df)

## # A tibble: 7 × 2
##   secondaryType  count
##   <chr>          <int>
## 1 Wrist Shot    484024
## 2 Slap Shot     163164
## 3 Snap Shot     132051
## 4 Backhand       76500
## 5 Tip-In         44655
## 6 Deflected      14778
## 7 Wrap-around    10359

# Visualization of the frequency of different types of shots
options(scipen = 1) # No scientific notation

g1 <- count(NHL_Shot_Analysis_Data, secondaryType) %>%
  ggplot(aes(x = reorder(secondaryType, -n), y = n))+
  geom_col(aes(fill = as.factor(secondaryType))) +
  geom_label(aes(label = n), label.size = 0.1, vjust = -0.3)+
  scale_y_continuous(name = "Frequency", limits = c(0, 550000), breaks = c(0, 100000,200000,300000,400000,500000))+
  scale_x_discrete(name = "Types of Shot") +
  ggtitle(paste("Frequency of Types of Shot n =", sum(shots.count.df$count),sep = " "))

# Conversion Rate of Different Types of Shot
Shot.df <- NHL_Shot_Analysis_Data %>%
  filter(event == "Shot" & is.na(secondaryType) == F) %>%
  group_by(secondaryType) %>%
  summarise(count=n())

Goal.df <- NHL_Shot_Analysis_Data %>%
  filter(event == "Goal" & is.na(secondaryType) == F) %>%
  group_by(secondaryType) %>%
  summarise(count=n())

Shot_Conversion.df <- data.frame(Type_of_Shots = Shot.df$secondaryType, Conversion_Rate = round(Goal.df$count/Shot.df$count, digits = 2))

g2 <- ggplot(Shot_Conversion.df, aes(x = reorder(Type_of_Shots, -Conversion_Rate), y = Conversion_Rate))+
  geom_col(aes(fill = as.factor(Type_of_Shots)))+
  geom_label(aes(label = Conversion_Rate), label.size = 0.1, vjust = -0.3)+
  scale_y_continuous(name = "Conversion Rate", limits = c(0, 0.25), breaks = c(0, 0.05, 0.10, 0.15, 0.20, 0.25))+
  scale_x_discrete(name = "Types of Shot") +
  ggtitle("Conversion Rate of Different Types of Shot")

# Create a Side-by-Side Bar chart
g3 <- ggarrange(g1,g2,
                labels = c ("A", "B"),
                ncol = 1, nrow = 2,
                common.legend = T, legend = "right")

print(g3)

# Add a graph of the rink
rink <- rasterGrob(readJPEG("ice_rink.jpg"),
                   width = unit(1.1,"npc"), height=unit(1.1, "npc"))
unique(NHL_Shot_Analysis_Data$secondaryType)

## [1] "Wrist Shot"  "Wrap-around" "Slap Shot"   "Tip-In"      "Snap Shot"  
## [6] "Backhand"    "Deflected"

# Wrap-around
ggplot(NHL_Shot_Analysis_Data[NHL_Shot_Analysis_Data$secondaryType == "Wrap-around",],
       aes(x = x, y = y, group = event, color = event, size = event))+
  annotation_custom(rink, -100, 100, -40, 40) + 
  geom_point() +
  theme_bw() +
  theme(panel.grid.major = element_blank(), # Remove grid
        panel.grid.minor = element_blank(), # Remove grid
        panel.border = element_blank(), # Remove grid
        panel.background = element_blank()) + # Remove grid 
  scale_color_manual(values = c("Shot" = "blue3", "Goal" = "red2")) +
  scale_size_manual(values = c("Shot" = 1.5, "Goal" = 2)) +
  scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
  scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
  labs(x = "Sideline", y = "Baseline",
       title = "NHL Shot Layout",
       subtitle = "Wrap-around shot type")

# Deflected
ggplot(NHL_Shot_Analysis_Data[NHL_Shot_Analysis_Data$secondaryType == "Deflected",],
       aes(x = x, y = y, group = event, color = event, size = event))+
    annotation_custom(rink, -100, 100, -40, 40) + 
  geom_point() +
  theme_bw() +
  theme(panel.grid.major = element_blank(), # Remove grid
        panel.grid.minor = element_blank(), # Remove grid
        panel.border = element_blank(), # Remove grid
        panel.background = element_blank()) + # Remove grid 
  scale_color_manual(values = c("Shot" = "blue3", "Goal" = "red2")) +
  scale_size_manual(values = c("Shot" = 1.5, "Goal" = 2)) +
  scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
  scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
  labs(x = "Sideline", y = "Baseline",
       title = "NHL Shot Layout",
       subtitle = "Deflected shot type")

## Warning: Removed 16 rows containing missing values (`geom_point()`).

# Backhand
# The original size of the category is too large to present in the graph. Select a sample size of 20,000
set.seed(123)
ggplot(sample_n(NHL_Shot_Analysis_Data[NHL_Shot_Analysis_Data$secondaryType == "Backhand",],20000),
       aes(x = x, y = y, group = event, color = event, size = event))+
    annotation_custom(rink, -100, 100, -40, 40) + 
  geom_point() +
  theme_bw() +
  theme(panel.grid.major = element_blank(), # Remove grid
        panel.grid.minor = element_blank(), # Remove grid
        panel.border = element_blank(), # Remove grid
        panel.background = element_blank()) + # Remove grid 
  scale_color_manual(values = c("Shot" = "blue3", "Goal" = "red2")) +
  scale_size_manual(values = c("Shot" = 1.5, "Goal" = 2)) +
  scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
  scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
  labs(x = "Sideline", y = "Baseline",
       title = "NHL Shot Layout",
       subtitle = "Backhand shot type")

## Warning: Removed 7 rows containing missing values (`geom_point()`).

# Snap Shot
set.seed(123)
ggplot(sample_n(NHL_Shot_Analysis_Data[NHL_Shot_Analysis_Data$secondaryType == "Snap Shot",],20000),
       aes(x = x, y = y, group = event, color = event, size = event))+
    annotation_custom(rink, -100, 100, -40, 40) + 
  geom_point() +
  theme_bw() +
  theme(panel.grid.major = element_blank(), # Remove grid
        panel.grid.minor = element_blank(), # Remove grid
        panel.border = element_blank(), # Remove grid
        panel.background = element_blank()) + # Remove grid 
  scale_color_manual(values = c("Shot" = "blue3", "Goal" = "red2")) +
  scale_size_manual(values = c("Shot" = 1.5, "Goal" = 2)) +
  scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
  scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
  labs(x = "Sideline", y = "Baseline",
       title = "NHL Shot Layout",
       subtitle = "Snap shot type")

## Warning: Removed 20 rows containing missing values (`geom_point()`).

# Slap shot
set.seed(123)
ggplot(sample_n(NHL_Shot_Analysis_Data[NHL_Shot_Analysis_Data$secondaryType == "Slap Shot",],20000),
       aes(x = x, y = y, group = event, color = event, size = event))+
    annotation_custom(rink, -100, 100, -40, 40) + 
  geom_point() +
  theme_bw() +
  theme(panel.grid.major = element_blank(), # Remove grid
        panel.grid.minor = element_blank(), # Remove grid
        panel.border = element_blank(), # Remove grid
        panel.background = element_blank()) + # Remove grid 
  scale_color_manual(values = c("Shot" = "blue3", "Goal" = "red2")) +
  scale_size_manual(values = c("Shot" = 1.5, "Goal" = 2)) +
  scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
  scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
  labs(x = "Sideline", y = "Baseline",
       title = "NHL Shot Layout",
       subtitle = "Slap shot type")

## Warning: Removed 8 rows containing missing values (`geom_point()`).

#Wrist shot
set.seed(123)
ggplot(sample_n(NHL_Shot_Analysis_Data[NHL_Shot_Analysis_Data$secondaryType == "Wrist Shot",],20000),
       aes(x = x, y = y, group = event, color = event, size = event))+
    annotation_custom(rink, -100, 100, -40, 40) + 
  geom_point() +
  theme_bw() +
  theme(panel.grid.major = element_blank(), # Remove grid
        panel.grid.minor = element_blank(), # Remove grid
        panel.border = element_blank(), # Remove grid
        panel.background = element_blank()) + # Remove grid 
  scale_color_manual(values = c("Shot" = "blue3", "Goal" = "red2")) +
  scale_size_manual(values = c("Shot" = 1.5, "Goal" = 2)) +
  scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
  scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
  labs(x = "Sideline", y = "Baseline",
       title = "NHL Shot Layout",
       subtitle = "Wrist shot type")

## Warning: Removed 23 rows containing missing values (`geom_point()`).

# Tip-in
ggplot(NHL_Shot_Analysis_Data[NHL_Shot_Analysis_Data$secondaryType == "Tip-In",],
       aes(x = x, y = y, group = event, color = event, size = event))+
    annotation_custom(rink, -100, 100, -40, 40) + 
  geom_point() +
  theme_bw() +
  theme(panel.grid.major = element_blank(), # Remove grid
        panel.grid.minor = element_blank(), # Remove grid
        panel.border = element_blank(), # Remove grid
        panel.background = element_blank()) + # Remove grid 
  scale_color_manual(values = c("Shot" = "blue3", "Goal" = "red2")) +
  scale_size_manual(values = c("Shot" = 1.5, "Goal" = 2)) +
  scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
  scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
  labs(x = "Sideline", y = "Baseline",
       title = "NHL Shot Layout",
       subtitle = "Tip-In shot type")

## Warning: Removed 9 rows containing missing values (`geom_point()`).

Goal Heatmap Analysis

OnlyGoal <- NHL_Shot_Analysis_Data[NHL_Shot_Analysis_Data$event == "Goal",]

# Wrap-around
ggplot(OnlyGoal[OnlyGoal$secondaryType == "Wrap-around",],
       aes(x = x, y = y))+
    annotation_custom(rink, -100, 100, -40, 40) + 
    geom_bin2d( bins = 30)+
    theme_bw() +
    theme(panel.grid.major = element_blank(), # Remove grid
      panel.grid.minor = element_blank(), # Remove grid
      panel.border = element_blank(), # Remove grid
      panel.background = element_blank()) + # Remove grid 
    scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
    scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
      labs(x = "Sideline", y = "Baseline",
      title = "NHL Goal Density Heatmap",
      subtitle = "Wrap-around shot type")

## Warning: Removed 1 rows containing missing values (`geom_tile()`).

# Deflected
ggplot(OnlyGoal[OnlyGoal$secondaryType == "Deflected",],
       aes(x = x, y = y))+
    annotation_custom(rink, -100, 100, -40, 40) + 
    geom_bin2d()+
    theme_bw() +
    theme(panel.grid.major = element_blank(), # Remove grid
      panel.grid.minor = element_blank(), # Remove grid
      panel.border = element_blank(), # Remove grid
      panel.background = element_blank()) + # Remove grid 
    scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
    scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
      labs(x = "Sideline", y = "Baseline",
      title = "NHL Goal Density Heatmap",
      subtitle = "Deflected shot type")

## Warning: Removed 20 rows containing missing values (`geom_tile()`).

# Backhand
ggplot(OnlyGoal[OnlyGoal$secondaryType == "Backhand",],
       aes(x = x, y = y))+
    annotation_custom(rink, -100, 100, -40, 40) + 
    geom_bin2d()+
    theme_bw() +
    theme(panel.grid.major = element_blank(), # Remove grid
      panel.grid.minor = element_blank(), # Remove grid
      panel.border = element_blank(), # Remove grid
      panel.background = element_blank()) + # Remove grid 
    scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
    scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
      labs(x = "Sideline", y = "Baseline",
      title = "NHL Goal Density Heatmap",
      subtitle = "Backhand shot type")

## Warning: Removed 19 rows containing missing values (`geom_tile()`).

# Snap Shot
ggplot(OnlyGoal[OnlyGoal$secondaryType == "Snap Shot",],
       aes(x = x, y = y))+
    annotation_custom(rink, -100, 100, -40, 40) + 
    geom_bin2d()+
    theme_bw() +
    theme(panel.grid.major = element_blank(), # Remove grid
      panel.grid.minor = element_blank(), # Remove grid
      panel.border = element_blank(), # Remove grid
      panel.background = element_blank()) + # Remove grid 
    scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
    scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
      labs(x = "Sideline", y = "Baseline",
      title = "NHL Goal Density Heatmap",
      subtitle = "Snap Shot shot type")

## Warning: Removed 21 rows containing missing values (`geom_tile()`).

# Slap Shot
ggplot(OnlyGoal[OnlyGoal$secondaryType == "Slap Shot",],
       aes(x = x, y = y))+
    annotation_custom(rink, -100, 100, -40, 40) + 
    geom_bin2d()+
    theme_bw() +
    theme(panel.grid.major = element_blank(), # Remove grid
      panel.grid.minor = element_blank(), # Remove grid
      panel.border = element_blank(), # Remove grid
      panel.background = element_blank()) + # Remove grid 
    scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
    scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
      labs(x = "Sideline", y = "Baseline",
      title = "NHL Goal Density Heatmap",
      subtitle = "Slap Shot shot type")

## Warning: Removed 4 rows containing non-finite values (`stat_bin2d()`).

## Warning: Removed 17 rows containing missing values (`geom_tile()`).

#Wrist Shot
set.seed(123)
ggplot(sample_n(OnlyGoal[OnlyGoal$secondaryType == "Wrist Shot",],10000),
       aes(x = x, y = y))+
    annotation_custom(rink, -100, 100, -40, 40) + 
    geom_bin2d()+
    theme_bw() +
    theme(panel.grid.major = element_blank(), # Remove grid
      panel.grid.minor = element_blank(), # Remove grid
      panel.border = element_blank(), # Remove grid
      panel.background = element_blank()) + # Remove grid 
    scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
    scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
      labs(x = "Sideline", y = "Baseline",
      title = "NHL Goal Density Heatmap",
      subtitle = "Wrist Shot shot type")

## Warning: Removed 1 rows containing non-finite values (`stat_bin2d()`).

## Warning: Removed 40 rows containing missing values (`geom_tile()`).

# Tip-in
ggplot(OnlyGoal[OnlyGoal$secondaryType == "Tip-In",],
       aes(x = x, y = y))+
    annotation_custom(rink, -100, 100, -40, 40) + 
    geom_bin2d()+
    theme_bw() +
    theme(panel.grid.major = element_blank(), # Remove grid
      panel.grid.minor = element_blank(), # Remove grid
      panel.border = element_blank(), # Remove grid
      panel.background = element_blank()) + # Remove grid 
    scale_x_continuous(limits = c(-100,100), breaks = c(-100, -50, 0, 50, 100))+
    scale_y_continuous(limits = c(-40,40), breaks = c(-40,-20,0,20,40))+
      labs(x = "Sideline", y = "Baseline",
      title = "NHL Goal Density Heatmap",
      subtitle = "Tip-In shot type")

## Warning: Removed 5 rows containing missing values (`geom_tile()`).